home *** CD-ROM | disk | FTP | other *** search
- MODULE main;
-
-
- (* MemoryBoardTest (alias Main) Copyright By: George Vokalek
- South Australia
-
- This code was written for production testing of memory boards for A1000's.
- The boards were not autoconfiguring so the code does not allocate memory
- before it starts stomping on it, so it will make systems with autoconfig
- boards crash.
-
- Feel free to use/modify this program, just leave this babble at the
- front intact. Good luck and Good Memory!
-
- *)
-
-
- FROM InOut IMPORT WriteLn,WriteString,WriteInt;
- FROM Strings IMPORT String, Concat, SetTerminator, Length;
- FROM SYSTEM IMPORT ADR, WORD,BYTE,NULL,ADDRESS;
- FROM Pens IMPORT SetAPen,SetDrMd,Move,Draw,RectFill;
- FROM Rasters IMPORT RastPort,RastPortPtr;
- FROM Ports IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort;
- FROM Colors IMPORT ColorMap, ColorMapPtr;
- FROM Windows IMPORT OpenWindow, CloseWindow;
- FROM Text IMPORT Text;
- FROM Conversions IMPORT ConvertToString;
- FROM myscreen IMPORT RP,InitScreen,EndMake,ourwindow,stadrgadg,enadrgadg,
- stadrresult,enadrresult,errresult,stgadgstring,
- engadgstring,errgadgstring,Refresh, looperresult;
- FROM Intuition IMPORT IDCMPFlags, IDCMPFlagSet,IntuiMessage, IntuiMessagePtr,
- GadgetPtr, Requester,SelectDown, SelectUp;
- FROM GraphicsLibrary IMPORT DrawingModes,DrawingModeSet;
- FROM Gadgets IMPORT RefreshGadgets;
- FROM mtest IMPORT Convert, HexChar, DoRandom, DoLinear, DoBits;
- FROM supertest IMPORT DoSuperBits;
- FROM mdraw IMPORT drawpixel,initmatrix;
- FROM mygadg IMPORT messtext,modetext,filestatustext;
- FROM DOSLibrary IMPORT DOSBase, DOSName;
- FROM DOSCodeLoader IMPORT Execute;
- FROM Libraries IMPORT OpenLibrary, CloseLibrary;
- FROM LongInOut IMPORT WriteLongCard;
-
- TYPE modetype = (nomode,linear,random,bits,super) ;
- lastgadgettype = (none,startaddress,endaddress,errornumber,start,reread,
- inc,dec,saveg,dont,randwise,linwise,bitwise,superwise,
- mess,nomess,loopcounter, palettecall);
-
- VAR
- lastgadget, laststringgadget : lastgadgettype;
- k : LONGCARD;
- i,l : CARDINAL;
- class : IDCMPFlagSet;
- code : CARDINAL;
- mesg : IntuiMessagePtr;
- OK, quit, done, save, domess : BOOLEAN;
- mode : modetype;
- testadr : LONGCARD;
- tempadr,startad,endad : ADDRESS;
- mx,my, errorlimit,loops : INTEGER;
- igadg,gtemp : GadgetPtr;
- gadgid,px,py : CARDINAL;
- dummy : Requester;
- nomodemessage, startmessage, stopmessage, blankmessage, tempstring : String;
-
-
-
-
- BEGIN
- startmessage := 'Starting test now ';
- stopmessage := 'Test Aborted ';
- nomodemessage := 'No Mode Selected ';
- blankmessage := ' ';
-
- mode := bits;
- lastgadget := none;
- laststringgadget := none;
- save := FALSE;
- domess := FALSE;
-
- IF InitScreen(640,400,3) THEN
- initmatrix;
-
- k:=1000000;
- quit := FALSE;
- domess := TRUE;
- save := FALSE;
-
- WHILE NOT quit DO
- mesg:=IntuiMessagePtr(WaitPort(ourwindow^.UserPort));
- (* note that waitport() does not pull the message off the queue!! *)
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- WHILE (mesg=NULL) DO
- mesg:=IntuiMessagePtr(GetMsg(ourwindow^.UserPort));
- END; (*for *)
- IF k=0 THEN
- quit:=TRUE;
- ELSIF mesg<>NULL THEN
- class := mesg^.Class;
- code := mesg^.Code;
- ReplyMsg(MessagePtr(mesg));
-
- IF IDCMPFlags(CloseWindowFlag) IN class THEN
- quit:=TRUE;
- END; (* if *)
- IF IDCMPFlags(ActiveWindow) IN class THEN
- END; (* if *)
- IF IDCMPFlags(InactiveWindow) IN class THEN
- END; (* if *)
- IF IDCMPFlags(GadgetDown) IN class THEN
- igadg := GadgetPtr(mesg^.IAddress);
- gadgid := igadg^.GadgetID;
-
- CASE gadgid OF
- 1: CASE mode OF
- random : modetext:='LINEAR TEST ';
- lastgadget:=randwise;
- mode:=linear;
- | linear : modetext:='BIT TEST ';
- lastgadget:=linwise;
- mode:=bits;
- | bits : modetext:='SUPER BIT TEST';
- lastgadget:=bitwise;
- mode:=super;
- | super : modetext:='RANDOM TEST ';
- lastgadget:=superwise;
- mode:=random;
- | ELSE;
- END; (* case *) |
- 3: lastgadget := start; |
- 4: lastgadget := reread; |
- 5: lastgadget := dec;
- CASE laststringgadget OF
- startaddress: startad:=Convert(stadrresult);
- DEC(startad,2);
- ConvertToString(LONGCARD(startad),
- 16,
- FALSE,
- stadrresult,
- done); |
- endaddress: endad :=Convert(enadrresult);
- DEC(endad,2);
- ConvertToString(LONGCARD(endad),
- 16,
- FALSE,
- enadrresult,
- done); |
- errornumber : errorlimit := INTEGER(Convert(errresult));
- IF errorlimit > 0 THEN
- DEC(errorlimit,1);
- END; (* if *)
- ConvertToString(LONGCARD(errorlimit),
- 16,
- FALSE,
- errresult,
- done); |
- loopcounter : loops := INTEGER(Convert(looperresult));
- IF loops > 0 THEN
- DEC(loops,1);
- END; (* if *)
- ConvertToString(LONGCARD(loops),
- 16,
- FALSE,
- looperresult,
- done); |
- ELSE ;
- END; (* case *) |
-
- 6: lastgadget := inc;
- CASE laststringgadget OF
- startaddress: startad:=Convert(stadrresult);
- INC(startad,2);
- ConvertToString(LONGCARD(startad),
- 16,
- FALSE,
- stadrresult,
- done); |
- endaddress: endad :=Convert(enadrresult);
- INC(endad,2);
- ConvertToString(LONGCARD(endad),
- 16,
- FALSE,
- enadrresult,
- done); |
- errornumber : errorlimit := INTEGER(Convert(errresult));
- INC(errorlimit,1);
- ConvertToString(LONGCARD(errorlimit),
- 16,
- FALSE,
- errresult,
- done); |
- loopcounter : loops := INTEGER(Convert(looperresult));
- INC(loops,1);
- ConvertToString(LONGCARD(loops),
- 16,
- FALSE,
- looperresult,
- done); |
- ELSE ;
- END; (* case *) |
-
- 7: CASE save OF
- TRUE : filestatustext:='NOT SAVING ';
- lastgadget:=dont;
- save:=FALSE; |
- FALSE : filestatustext:='SAVING TO FILE';
- lastgadget:=saveg;
- save:=TRUE; |
- ELSE;
- END; (* case *) |
-
- 8: lastgadget := palettecall;
- DOSBase := OpenLibrary(DOSName,0);
- OK := Execute('palette',0,0);
- CloseLibrary(DOSBase); |
- 10: laststringgadget := startaddress;
- lastgadget := startaddress; |
- 11: laststringgadget := endaddress;
- lastgadget := endaddress; |
- 12: laststringgadget := errornumber;
- lastgadget := errornumber; |
- 13: laststringgadget := loopcounter;
- lastgadget := loopcounter; |
- 20: CASE domess OF
- TRUE : messtext := 'QUIET ';
- lastgadget := mess;
- domess := FALSE; |
- FALSE : messtext := 'DISPLAY ERRORS';
- lastgadget := nomess;
- domess := TRUE; |
- ELSE;
- END; (* case *)
- ELSE ;
- END; (* case *)
- END; (* if *)
-
- IF (IDCMPFlags(MouseButtons) IN class) AND (code = SelectUp) THEN
- Refresh;
- END; (* if *)
-
- IF (IDCMPFlags(MouseButtons) IN class) AND (code = SelectDown) THEN
- mx := mesg^.MouseX;
- my := mesg^.MouseY;
- IF (mx > 325) AND (mx < 640) AND (my > 43) AND (my < 310) THEN
- px := CARDINAL((mx - 325) DIV 20);
- py := CARDINAL((my - 43) DIV 15);
-
- CASE laststringgadget OF
- startaddress: ConvertToString(LONGCARD(LONGINT(px*16+py)
- *LONGINT(65536)),
- 16,
- FALSE,
- stadrresult,
- done);
- IF px = 0 THEN
- stadrresult[6] := CHR(0);
- stadrresult[5] := stadrresult[4];
- stadrresult[4] := stadrresult[3];
- stadrresult[3] := stadrresult[2];
- stadrresult[2] := stadrresult[1];
- stadrresult[1] := stadrresult[0];
- stadrresult[0] := ' ';
- IF py = 0 THEN
- stadrresult := '000000';
- END; (* if *)
- END; (* if *)
- stgadgstring.NumChars := 6; |
-
- endaddress : ConvertToString(LONGCARD(LONGINT(px*16+py)
- *LONGINT(65536)),
- 16,
- FALSE,
- enadrresult,
- done);
- IF px = 0 THEN
- enadrresult[6] := CHR(0);
- enadrresult[5] := enadrresult[4];
- enadrresult[4] := enadrresult[3];
- enadrresult[3] := enadrresult[2];
- enadrresult[2] := enadrresult[1];
- enadrresult[1] := enadrresult[0];
- enadrresult[0] := ' ';
- IF py = 0 THEN
- enadrresult := '000000';
- END; (* if *)
- END; (* if *)
- engadgstring.NumChars := 6; |
-
- errornumber : ConvertToString(LONGCARD(LONGINT(px*16+py)
- *LONGINT(16)),
- 16,
- FALSE,
- errresult,
- done);
- IF px = 0 THEN
- errresult[4] := CHR(0);
- errresult[3] := errresult[2];
- errresult[2] := errresult[1];
- errresult[1] := errresult[0];
- errresult[0] := ' ';
- IF py = 0 THEN
- errresult := '0000';
- END; (* if *)
- END; (* if *)
- errgadgstring.NumChars := 4; |
-
- loopcounter : ConvertToString(LONGCARD(LONGINT(px*16+py)
- *LONGINT(16)),
- 16,
- FALSE,
- looperresult,
- done);
- IF px = 0 THEN
- looperresult[4] := CHR(0);
- looperresult[3] := looperresult[2];
- looperresult[2] := looperresult[1];
- looperresult[1] := looperresult[0];
- looperresult[0] := ' ';
- IF py = 0 THEN
- looperresult := '0001';
- END; (* if *)
- END; (* if *)
- errgadgstring.NumChars := 4; |
-
- ELSE ;
- END; (* case *)
-
- ELSIF (mx > 325) AND (mx < 640) AND (my > 25) AND (my < 40) THEN
- px := CARDINAL((mx - 325) DIV 20);
-
- CASE laststringgadget OF
- startaddress: stadrresult[0] := stadrresult[1];
- stadrresult[1] := stadrresult[2];
- stadrresult[2] := stadrresult[3];
- stadrresult[3] := stadrresult[4];
- stadrresult[4] := stadrresult[5];
- stadrresult[5] := HexChar(INTEGER(px));
- stgadgstring.NumChars := 6; |
-
- endaddress: enadrresult[0] := enadrresult[1];
- enadrresult[1] := enadrresult[2];
- enadrresult[2] := enadrresult[3];
- enadrresult[3] := enadrresult[4];
- enadrresult[4] := enadrresult[5];
- enadrresult[5] := HexChar(INTEGER(px));
- engadgstring.NumChars := 6; |
-
- errornumber : errresult[0] := errresult[1];
- errresult[1] := errresult[2];
- errresult[2] := errresult[3];
- errresult[3] := HexChar(INTEGER(px));
- errgadgstring.NumChars := 4; |
-
- loopcounter : looperresult[0] := looperresult[1];
- looperresult[1] := looperresult[2];
- looperresult[2] := looperresult[3];
- looperresult[3] := HexChar(INTEGER(px));
- errgadgstring.NumChars := 4; |
-
- ELSE ;
- END; (* case *)
- END; (* elsif top row hit *)
- END; (* if mousebutton event *)
- IF IDCMPFlags(GadgetUp) IN class THEN
- CASE lastgadget OF
- start: startad := Convert(stadrresult);
- (* WriteLongCard(LONGCARD(startad),10);
- WriteLn; *)
- endad := Convert(enadrresult);
- (* WriteLongCard(LONGCARD(endad),10);
- WriteLn; *)
- errorlimit := INTEGER(Convert(errresult));
- loops := INTEGER(Convert(looperresult));
- tempstring := looperresult ;
-
- WHILE loops > 0 DO
- initmatrix;
- CASE mode OF
- random : DoRandom(startad,endad,errorlimit,save,
- TRUE, domess)
- | linear : DoLinear(startad,endad,errorlimit,save,
- TRUE, domess)
- | bits : DoBits(startad,endad,errorlimit,save,
- TRUE, domess)
- | super : DoSuperBits(startad,endad,errorlimit,save,
- TRUE, domess)
- | ELSE
- SetAPen(RP,4);
- Move(RP,30,250);
- Text(RP,nomodemessage,20);
- END ; (* case *)
- DEC(loops,1);
- ConvertToString(LONGCARD(loops),
- 16,
- FALSE,
- looperresult,
- done);
- l:=Length(looperresult);
- FOR i:=0 TO 3-l DO
- looperresult[l+i]:=' ';
- END; (* for *)
- looperresult[4]:=CHR(0);
- Refresh;
- END; (* while *)
- looperresult := tempstring;
- Refresh; |
-
- reread: startad := Convert(stadrresult);
- endad := Convert(enadrresult);
- errorlimit := INTEGER(Convert(errresult));
- loops := INTEGER(Convert(looperresult));
- tempstring := looperresult;
-
- WHILE loops > 0 DO
- initmatrix;
- CASE mode OF
- random : DoRandom(startad,endad,errorlimit,save,
- FALSE, domess)
- | linear : DoLinear(startad,endad,errorlimit,save,
- FALSE, domess)
- | bits : DoBits(startad,endad,errorlimit,save,
- FALSE, domess)
- | super : DoSuperBits(startad,endad,errorlimit,save,
- FALSE, domess);
- | ELSE
- SetAPen(RP,4);
- Move(RP,30,250);
- Text(RP,nomodemessage,20);
- END; (* case *)
- DEC(loops,1);
- ConvertToString(LONGCARD(loops),
- 16,
- FALSE,
- looperresult,
- done);
- l:=Length(looperresult);
- FOR i:=0 TO 3-l DO
- looperresult[l+i]:=' ';
- END; (* for *)
- looperresult[4]:=CHR(0);
- Refresh;
- END; (* while *)
- looperresult := tempstring;
- Refresh; |
-
- ELSE Refresh;
- END; (* case *)
- END; (* if gadget upped *)
- END; (* elsif mesg <> null *)
- END; (*while *)
- EndMake;
- END; (* if *)
- END main.
-
-